home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / dos / pascal / tpstat.exe / STAT.PAS < prev    next >
Pascal/Delphi Source File  |  1990-08-08  |  45KB  |  1,590 lines
  1. {--------------------------------------------------------------------------}
  2. {                         Norton Statistical Library                       }
  3. {                                                                          }
  4. {                              Version   1.00                              }
  5. {                                                                          }
  6. {                                                                          }
  7. {                    Copyright 1990 Norton Associcates                     }
  8. {                           All Rights Reserved                            }
  9. {                          Restricted by License                           }
  10. {--------------------------------------------------------------------------}
  11.  
  12.                      {--------------------------------}
  13.                      {       Unit:   Stat             }
  14.                      {--------------------------------}
  15.  
  16.  
  17. {$S-,R-,V-,D-,A+,B+,N+,E-,I-}
  18.  
  19. UNIT
  20.     stat;
  21.  
  22. INTERFACE
  23.  
  24. CONST
  25.      error_value = -99.9;                         { if any errors }
  26.      maxsize     = 65520;                         { max segment size }
  27.      maxsingle   = maxsize DIV (SIZEOF(SINGLE));  { max element size single array }
  28.      maxdouble   = maxsize DIV (SIZEOF(DOUBLE));  { max element size double array }
  29.      maxlongint  = maxsize DIV (SIZEOF(LONGINT)); { max element size longint array }
  30.  
  31.      v1   : INTEGER = 1;                       { constants for uniform1 }
  32.      v2   : INTEGER = 1000;                    { constants for uniform1 }
  33.      v3   : INTEGER = 30000;                   { constants for uniform1 }
  34.  
  35.      maxorder  = 10;
  36.      maxmatrix = maxorder * 2 - 1;
  37.  
  38.      uno   = 1;
  39.      dos   = 2;
  40.      zero  = 0.0;
  41.      one   = 1.0;
  42.      two   = 2.0;
  43.      c2    = 2.0;
  44.      c3    = -3.0;
  45.      c4    = 4.0;
  46.      c5    = 5.0;
  47.      c6    = 6.0;
  48.      c11   = 11.0;
  49.      c12   = 12.0;
  50.      c17   = 17.0;
  51.      i_4   = 1.0/c4;
  52.      i_16  = 1.0/16.0;
  53.      i_35  = 1.0/35.0;
  54.  
  55. TYPE
  56.  
  57.     single_array_type    = SINGLE;
  58.     single_array_dummy   = ARRAY[1..maxsingle] OF single_array_type;
  59.     single_array_pointer = ^single_array_dummy;
  60.  
  61.     double_array_dummy   = ARRAY[1..maxdouble] OF DOUBLE;
  62.     double_array_pointer = ^double_array_dummy;
  63.  
  64.     longint_array_dummy   = ARRAY[1..maxlongint] OF LONGINT;
  65.     longint_array_pointer = ^longint_array_dummy;
  66.  
  67.     quartype  = ARRAY[1..5] OF SINGLE;
  68.     arry_type = ARRAY[1..maxorder,1..maxorder] OF EXTENDED;
  69.  
  70. PROCEDURE create_single_array( num: WORD; VAR xx : single_array_pointer);
  71. PROCEDURE delete_single_array( num: WORD; VAR xx : single_array_pointer);
  72. PROCEDURE create_longint_array( num: WORD; VAR xx : longint_array_pointer);
  73. PROCEDURE delete_longint_array( num: WORD; VAR xx : longint_array_pointer);
  74.  
  75. FUNCTION uniform1 : SINGLE;
  76. FUNCTION rndnorm1( mean,standev:EXTENDED) :SINGLE;
  77. FUNCTION rndnorm2( mean,standev:EXTENDED) :SINGLE;
  78.  
  79. PROCEDURE insert( n : WORD ; VAR a : single_array_pointer) ;
  80. PROCEDURE qsort( n : WORD; VAR a : single_array_pointer) ;
  81. PROCEDURE remove_avg( n : WORD; VAR a : single_array_pointer ; avg : SINGLE);
  82.  
  83. PROCEDURE means( n :WORD; a : single_array_pointer; VAR xmean,gmean,hmean,rmsmean :SINGLE);
  84. PROCEDURE wxmean( num : WORD; a : single_array_pointer; freq : longint_array_pointer; VAR mean,sd,small,large : SINGLE);
  85. PROCEDURE elem_stat( num:WORD; VAR a:single_array_pointer;
  86.                     VAR small,large:SINGLE; VAR mean,sd:SINGLE);
  87. PROCEDURE moments( n      : WORD;
  88.                    a      : single_array_pointer;
  89.                 VAR ave   : SINGLE;
  90.                 VAR std   : SINGLE;
  91.                 VAR skew  : SINGLE;
  92.                 VAR beta2 : SINGLE);
  93.  
  94. PROCEDURE quart( n : WORD; a : single_array_pointer; VAR quart  : quartype);
  95. FUNCTION percentile( n : WORD; a : single_array_pointer ;percent : SINGLE) : SINGLE;
  96. FUNCTION standard_error(num : WORD ; sd : SINGLE; ntype:WORD) : SINGLE;
  97.  
  98. FUNCTION cdf_prob_to_sd(prob :SINGLE) : SINGLE;
  99. FUNCTION cdf_sd_to_prob(sd:SINGLE) : SINGLE;
  100. FUNCTION int_prob_to_sd(prob :SINGLE) : SINGLE;
  101. FUNCTION int_sd_to_prob(sd:SINGLE) : SINGLE;
  102.  
  103. PROCEDURE corcoef(n: WORD; x,y:single_array_pointer; VAR r:SINGLE);
  104. PROCEDURE autocor(n:WORD; x:single_array_pointer; lag :WORD; VAR auto:single_array_pointer);
  105. PROCEDURE linfit(npts: WORD; x,y,sigmay: single_array_pointer; mode:WORD;VAR a,  b, r:SINGLE);
  106. FUNCTION determ(arry :arry_type; norder : INTEGER) : EXTENDED;
  107. PROCEDURE polfit(npts: WORD;
  108.                 x,y,sdy      : single_array_pointer;
  109.                 nterms,mode  : INTEGER;
  110.                 VAR a        : single_array_pointer;
  111.                 VAR r        : SINGLE;
  112.                 VAR se       : SINGLE);
  113. PROCEDURE mulreg(n : WORD; y,x,z : single_array_pointer;
  114.                           VAR a  : single_array_pointer;
  115.                           VAR r  : SINGLE;
  116.                           VAR se : SINGLE);
  117.  
  118. PROCEDURE smooth121(n:WORD; VAR y: single_array_pointer);
  119. PROCEDURE smooth14641(n:WORD; VAR y: single_array_pointer);
  120. PROCEDURE smoothcurve(n:WORD; VAR y: single_array_pointer);
  121. FUNCTION movavg(n: WORD; a : single_array_pointer; ma:WORD ; k : WORD) : SINGLE;
  122.  
  123. {*****************************************************************************}
  124. {*****************************************************************************}
  125. IMPLEMENTATION
  126. {*****************************************************************************}
  127. {*****************************************************************************}
  128.  
  129. PROCEDURE create_single_array( num: WORD; VAR xx : single_array_pointer);
  130. { Author : Norton Associates
  131.   Purpose: Properly create a single dimensioned heap array
  132.   Version: 1.0
  133.   Date   : 5 May 1990 }
  134.  
  135. VAR
  136.     maxnumber : LONGINT;    { proposed size of array in bytes }
  137.  
  138. BEGIN
  139.      maxnumber := LONGINT(LONGINT(num) * LONGINT(SIZEOF(single_array_type)));
  140.      IF (num < uno) or (num > maxsingle) THEN
  141.      BEGIN
  142.           WRITELN('Sorry the single array size is to large to create ');
  143.           WRITELN('You wanted = ',num:10,', The max single size = ',maxsingle:10);
  144.           HALT;
  145.      END;
  146.      GETMEM(xx,maxnumber);
  147. END;
  148.  
  149. PROCEDURE delete_single_array( num: WORD; VAR xx : single_array_pointer);
  150. { Author : Norton Associates
  151.   Purpose: Properly delete a single dimensioned heap array
  152.   Version: 1.0
  153.   Date   : 5 May 1990 }
  154.  
  155. VAR
  156.    maxnumber : LONGINT;  { proposed size of array in bytes }
  157.  
  158. BEGIN
  159.      maxnumber := LONGINT(LONGINT(num) * LONGINT(SIZEOF(single_array_type)));
  160.      IF maxnumber > maxsize THEN
  161.      BEGIN
  162.           WRITELN('sorry the single array size is to large to delete ',maxnumber);
  163.           HALT;
  164.      END;
  165.      FREEMEM(xx,maxnumber);
  166. END;
  167.  
  168. PROCEDURE create_longint_array( num: WORD; VAR xx : longint_array_pointer);
  169. { Author : Norton Associates
  170.   Purpose: Properly create a longint dimensioned heap array
  171.   Version: 1.0
  172.   Date   : 5 May 1990 }
  173.  
  174. VAR
  175.    maxnumber : LONGINT;  { proposed size of array in bytes }
  176.  
  177. BEGIN
  178.      maxnumber := LONGINT(LONGINT(num) * LONGINT(SIZEOF(single_array_type)));
  179.      IF (num < uno) or (num > maxlongint) THEN
  180.      BEGIN
  181.           WRITELN('sorry longint array size is to large to create',maxlongint);
  182.           HALT;
  183.      END;
  184.      GETMEM(xx,maxnumber);
  185. END;
  186.  
  187. PROCEDURE delete_longint_array( num: WORD; VAR xx : longint_array_pointer);
  188. { Author : Norton Associates
  189.   Purpose: Properly delete a longint dimensioned heap array
  190.   Version: 1.0
  191.   Date   : 5 May 1990 }
  192.  
  193. VAR
  194.    maxnumber : LONGINT;  { proposed size of array in bytes }
  195.  
  196. BEGIN
  197.      maxnumber := LONGINT(LONGINT(num) * LONGINT(SIZEOF(single_array_type)));
  198.      IF maxnumber > maxsize THEN
  199.      BEGIN
  200.           WRITELN('sorry longint array size is to large to delete',maxnumber);
  201.           HALT;
  202.      END;
  203.      GETMEM(xx,maxnumber);
  204. END;
  205.  
  206. PROCEDURE remove_avg(n : WORD; VAR a : single_array_pointer ; avg : SINGLE);
  207. { Author : Norton Associates
  208.   Purpose: Remove a constant value from an array
  209.   Version: 1.0
  210.   Date   : 5 May 1990 }
  211.  
  212. VAR
  213.    j : WORD;
  214.  
  215. BEGIN
  216.    IF n > 0 THEN
  217.    BEGIN
  218.        FOR j := uno TO n D